home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / StdEnv / Clean System Files / _system.abc < prev    next >
Encoding:
Text File  |  1997-05-29  |  18.2 KB  |  1,427 lines  |  [TEXT/3PRM]
  1. .comp 914 111111111
  2. .code 0 0 0
  3. .start _nostart_
  4. .endinfo
  5.  
  6. .implab    _eaind
  7. .implab    _indirection
  8.  
  9. .export    _channel_code
  10.  
  11. .export    EMPTY INT BOOL CHAR REAL FILE _STRING_ _ARRAY_ ARRAY
  12. .export    _reserve _cycle_in_spine _hnf 
  13. .export    _type_error _match_error selector_m_error index_error
  14. .export    _print_graph _eval_to_nf
  15. .export    _Tuple
  16. .export    _Select _select_code
  17. .export    _Nil _Cons
  18.  
  19. .export    e_system_dAP e_system_nAP e_system_eaAP _ind
  20. .export    e_system_dif e_system_lif e_system_sif e_system_nif e_system_eaif
  21. .export    _HnfReducer _hnf_reducer
  22. .export    _Defer _defer_code
  23.  
  24. .export    d_S.1 d_S.2 d_S.3 d_S.4 d_S.5 d_S.6
  25. .export    n_S.1 n_S.2 n_S.3 n_S.4 n_S.5 n_S.6
  26. .export    ea_S.1 ea_S.2 ea_S.3 ea_S.4 ea_S.5 ea_S.6
  27.  
  28. .export    _ind
  29.  
  30. || don't change the order of the following 9 descriptors
  31.  
  32. |.desc CHANNEL    _channel_code    _hnf    1    ""
  33. .desc GRAPH    _hnf    _hnf    0    ""
  34. .desc _ARRAY_    _hnf    _hnf    0    "_ARRAY_"
  35. .desc _STRING_    _hnf    _hnf    0    "_STRING_"
  36. |.desc STRING    _hnf    _hnf    0    "STRING"
  37. |.desc FILE    _hnf    _hnf    0    "FILE"
  38. .desc REAL    _hnf    _hnf    0    "REAL"
  39. .desc INT    _hnf    _hnf    0    "INT"
  40. .desc BOOL    _hnf    _hnf    0    "BOOL"
  41. .desc CHAR    _hnf    _hnf    0    "CHAR"
  42.  
  43. .desc EMPTY    _reserve    _hnf    0    "EMPTY"
  44.  
  45. .desc _Tuple    _hnf    _hnf    32    "_Tuple"
  46. .desc _Select    _hnf    _hnf    2    "_Select"
  47. .desc _Nil    _hnf    _hnf    0    "Nil"
  48. .desc _Cons    _hnf    _l_cons    2    "Cons"
  49.  
  50. .record FILE ii 0 2 "File"
  51.  
  52. .desc e_system_dAP    _hnf    e_system_lAP    2    "AP"
  53. .desc e_system_dif    e_system_nif    e_system_lif    3    "if"
  54. .desc _ind    _hnf    _hnf    0    "_ind"
  55.  
  56. .desc _Defer    _defer_code    _hnf    0    "_Defer"
  57.  
  58. .desc ARRAY    _hnf    _hnf    1    "ARRAY"
  59.  
  60. .desc _HnfReducer    _hnf_reducer    _hnf_reducer    0    "HnfReducer"
  61. | .desc _NfReducer    _nf_reducer    _nf_reducer    0    "NfReducer"
  62.  
  63. .o 0 2 i i
  64. _match_error
  65.     print    "Run time error, rule \'"
  66.     printD
  67.     print    "\' in module \'"
  68.     printD
  69.     print    "\' does not match\n"
  70.     halt
  71.  
  72. .o 0 0
  73. selector_m_error
  74.     print    "Run time error, selector does not match"
  75.     halt
  76.  
  77. .n 0 _Defer
  78. .o 1 0
  79. _defer_code
  80.     print    "Error: defer code entered"
  81.     halt
  82.  
  83. .o 2 0
  84. _l_cons
  85.     create
  86.     push_a    2
  87.     push_args    2 2 2
  88.     fill    _Cons 2 _hnf 2
  89.     update_a    0 2
  90.     pop_a    2
  91. .d 1 0
  92.     rtn
  93.  
  94. .n -2 _ind _eaind
  95. .o 1 0
  96. ind_code
  97. .d 1 0
  98.     jmp    _indirection
  99.  
  100. .desc d_S.1 n_S.1 o_S.1 1 "_S.1"
  101. .n -1 d_S.1 ea_S.1
  102. .o 1 0
  103. n_S.1
  104.     push_node _reserve 1
  105.     jsr_eval 0
  106.     get_node_arity 0
  107.     pushI 1
  108.     push_arg_b 0
  109.     jsr_eval 0
  110.     getWL 2
  111.     fill_a 0 2
  112.     release
  113.     pop_a 2
  114. .d 1 0
  115.     rtn
  116.  
  117. .o 1 0
  118. o_S.1
  119.     get_node_arity    0
  120.     pushI    1
  121.     push_arg_b    0
  122.     update_a    0 1
  123.     pop_a    1
  124. .d 1 0
  125.     rtn
  126.  
  127. .o 2 0
  128. ea_S.1
  129.     push_arg    0 1 1
  130.     push_a    2
  131. .keep 1 0
  132.     fill    _ind -2 ind_code 2
  133. .keep 1 0
  134.     update_a    0 1
  135.     pop_a    1
  136.     jsr_eval 0
  137.     get_node_arity    0
  138.     pushI    1
  139.     push_arg_b    0
  140.     update_a    0 1
  141.     pop_a    1
  142.     jmp_eval_upd
  143.  
  144. .desc d_S.2 n_S.2 o_S.2 1 "_S.2"
  145. .n -1 d_S.2 ea_S.2
  146. .o 1 0
  147. n_S.2
  148.     push_node _reserve 1
  149.     jsr_eval 0
  150.     get_node_arity 0
  151.     pushI 2
  152.     push_arg_b 0
  153.     jsr_eval 0
  154.     getWL 2
  155.     fill_a 0 2
  156.     release
  157.     pop_a 2
  158. .d 1 0
  159.     rtn
  160.  
  161. .o 1 0
  162. o_S.2
  163.     get_node_arity    0
  164.     eqI_b 2 0
  165.     jmp_false o_S.2_
  166.     pop_b 1
  167.     repl_arg 2 2
  168. .d 1 0
  169.     rtn
  170. o_S.2_
  171.     repl_arg 3 2
  172.     pop_b 1
  173. .d 1 0
  174.     rtn
  175.  
  176. .o 2 0
  177. ea_S.2
  178.     push_arg    0 1 1
  179.     push_a    2
  180. .keep 1 0
  181.     fill    _ind -2 ind_code 2
  182. .keep 1 0
  183.     update_a    0 1
  184.     pop_a    1
  185.     jsr_eval 0
  186.     get_node_arity    0
  187.     eqI_b 2 0
  188.     jmp_false ea_S.2_
  189.     pop_b 1
  190.     repl_arg 2 2
  191.     jmp_eval_upd
  192.  
  193. ea_S.2_
  194.     repl_arg 3 2
  195.     pop_b 1
  196.     jmp_eval_upd
  197.  
  198. .desc d_S.3 n_S.3 o_S.3 1 "_S.3"
  199. .n -1 d_S.3 ea_S.3
  200. .o 1 0
  201. n_S.3
  202.     push_node _reserve 1
  203.     jsr_eval 0
  204.     get_node_arity 0
  205.     pushI 3
  206.     push_arg_b 0
  207.     jsr_eval 0
  208.     getWL 2
  209.     fill_a 0 2
  210.     release
  211.     pop_a 2
  212. .d 1 0
  213.     rtn
  214.  
  215. .o 1 0
  216. o_S.3
  217.     get_node_arity    0
  218.     pushI    3
  219.     push_arg_b    0
  220.     update_a    0 1
  221.     pop_a    1
  222. .d 1 0
  223.     rtn
  224.  
  225. .o 2 0
  226. ea_S.3
  227.     push_arg    0 1 1
  228.     push_a    2
  229. .keep 1 0
  230.     fill    _ind -2 ind_code 2
  231. .keep 1 0
  232.     update_a    0 1
  233.     pop_a    1
  234.     jsr_eval 0
  235.     get_node_arity    0
  236.     pushI    3
  237.     push_arg_b    0
  238.     update_a    0 1
  239.     pop_a    1
  240.     jmp_eval_upd
  241.  
  242.  
  243. .desc d_S.4 n_S.4 o_S.4 1 "_S.4"
  244. .n -1 d_S.4 ea_S.4
  245. .o 1 0
  246. n_S.4
  247.     push_node _reserve 1
  248.     jsr_eval 0
  249.     get_node_arity 0
  250.     pushI 4
  251.     push_arg_b 0
  252.     jsr_eval 0
  253.     getWL 2
  254.     fill_a 0 2
  255.     release
  256.     pop_a 2
  257. .d 1 0
  258.     rtn
  259.  
  260. .o 1 0
  261. o_S.4
  262.     get_node_arity    0
  263.     pushI    4
  264.     push_arg_b    0
  265.     update_a    0 1
  266.     pop_a    1
  267. .d 1 0
  268.     rtn
  269.  
  270. .o 2 0
  271. ea_S.4
  272.     push_arg    0 1 1
  273.     push_a    2
  274. .keep 1 0
  275.     fill    _ind -2 ind_code 2
  276. .keep 1 0
  277.     update_a    0 1
  278.     pop_a    1
  279.     jsr_eval 0
  280.     get_node_arity    0
  281.     pushI    4
  282.     push_arg_b    0
  283.     update_a    0 1
  284.     pop_a    1
  285.     jmp_eval_upd
  286.  
  287.  
  288. .desc d_S.5 n_S.5 o_S.5 1 "_S.5"
  289. .n -1 d_S.5 ea_S.5
  290. .o 1 0
  291. n_S.5
  292.     push_node _reserve 1
  293.     jsr_eval 0
  294.     get_node_arity 0
  295.     pushI 5
  296.     push_arg_b 0
  297.     jsr_eval 0
  298.     getWL 2
  299.     fill_a 0 2
  300.     release
  301.     pop_a 2
  302. .d 1 0
  303.     rtn
  304.  
  305. .o 1 0
  306. o_S.5
  307.     get_node_arity    0
  308.     pushI    5
  309.     push_arg_b    0
  310.     update_a    0 1
  311.     pop_a    1
  312. .d 1 0
  313.     rtn
  314.  
  315. .o 2 0
  316. ea_S.5
  317.     push_arg    0 1 1
  318.     push_a    2
  319. .keep 1 0
  320.     fill    _ind -2 ind_code 2
  321. .keep 1 0
  322.     update_a    0 1
  323.     pop_a    1
  324.     jsr_eval 0
  325.     get_node_arity    0
  326.     pushI    5
  327.     push_arg_b    0
  328.     update_a    0 1
  329.     pop_a    1
  330.     jmp_eval_upd
  331.  
  332.  
  333. .desc d_S.6 n_S.6 o_S.6 1 "_S.6"
  334. .n -1 d_S.6 ea_S.6
  335. .o 1 0
  336. n_S.6
  337.     push_node _reserve 1
  338.     jsr_eval 0
  339.     get_node_arity 0
  340.     pushI 6
  341.     push_arg_b 0
  342.     jsr_eval 0
  343.     getWL 2
  344.     fill_a 0 2
  345.     release
  346.     pop_a 2
  347. .d 1 0
  348.     rtn
  349.  
  350. .o 1 0
  351. o_S.6
  352.     get_node_arity    0
  353.     pushI    6
  354.     push_arg_b    0
  355.     update_a    0 1
  356.     pop_a    1
  357. .d 1 0
  358.     rtn
  359.  
  360. .o 2 0
  361. ea_S.6
  362.     push_arg    0 1 1
  363.     push_a    2
  364. .keep 1 0
  365.     fill    _ind -2 ind_code 2
  366. .keep 1 0
  367.     update_a    0 1
  368.     pop_a    1
  369.     jsr_eval 0
  370.     get_node_arity    0
  371.     pushI    6
  372.     push_arg_b    0
  373.     update_a    0 1
  374.     pop_a    1
  375.     jmp_eval_upd
  376.  
  377.  
  378. .n 2 _Select
  379. .o 1 0
  380. _select_code
  381.     print    "Error: select code entered"
  382.     halt
  383.  
  384. .o 0 0
  385. e_system_lAP
  386.     print    "Error: lazy entry of AP entered"
  387.     halt
  388.  
  389. .o 3 0
  390. e_system_eaAP
  391. .d 2 0
  392.     jmp    ea_AP
  393.  
  394. .n 2 e_system_dAP e_system_eaAP
  395. .o 1 0
  396. e_system_nAP
  397.     push_node    _reserve 2
  398. .o 2 0
  399. ea_AP
  400.     jsr_eval 0
  401. .d 2 0
  402.     jsr    e_system_sAP
  403. .o 1 0
  404.     fill_a    0 1
  405.     pop_a    1
  406. .d 1 0
  407.     rtn
  408.  
  409. .o 2 0
  410. e_system_lif
  411.     repl_args 2 2
  412. .d 3 0
  413.     jmp eval_args_if
  414.  
  415. .n 3 e_system_dif e_system_eaif
  416. .o 1 0
  417. e_system_nif
  418.     push_node _reserve 3
  419. .d 3 0
  420.     jsr eval_args_if
  421. .o 1 0
  422.     getWL 1
  423.     fill_a 0 1
  424.     release
  425.     pop_a 1
  426. .d 1 0
  427.     rtn
  428.  
  429. .o 3 0
  430. eval_args_if
  431.     jsr_eval 0
  432.     pushB_a 0
  433.     pop_a 1
  434. .o 2 1 b
  435. e_system_sif
  436.     jmp_false ifelse
  437.     update_a 0 1
  438.     pop_a 1
  439.     jmp_eval
  440. ifelse
  441.     pop_a 1
  442.     jmp_eval
  443.  
  444. .o 4 0
  445. e_system_eaif
  446.     jsr_eval 0
  447.     pushB_a 0
  448.     pop_a 1
  449.     jmp_false eaifelse
  450.     update_a 0 1
  451.     pop_a 1
  452.     jmp_eval_upd
  453. eaifelse
  454.     pop_a 1
  455.     jmp_eval_upd
  456.  
  457. .n 0 _Nil
  458. .o 1 0            
  459. _hnf
  460. .d 1 0
  461.     rtn
  462.  
  463. .n 0 EMPTY
  464. .o 1 0
  465. _cycle_in_spine
  466. .o 1 0
  467. _reserve
  468.     print    "Run Time Warning: cycle in spine detected\n"
  469.     halt
  470.  
  471. |.n 0 EMPTY
  472. |.o 1 0
  473. |_reserve
  474. |    setwait    0
  475. |    suspend
  476. |.d 1 0
  477. |    rtn
  478.  
  479. .o 0 0
  480. _hnf_reducer
  481. .o 0 0
  482. _channel_code
  483.     halt
  484. |    jsr_eval 0
  485. |    stop_reducer
  486.  
  487. |.o 1 0
  488. |_nf_reduce:    jsr_eval 0
  489. |    get_node_arity    0
  490. |    eqI_b    0 0    | check if arity is zero
  491. |    jmp_true    _last1
  492. |    push_b    0    | replace the node by
  493. |    push_b    0
  494. |    repl_args_b        | its arguments
  495. |.o 0 1 i
  496. |_reduce_args
  497. |    eqI_b    0 0    | check nr of args to do
  498. |    jmp_true    _last
  499. |.d 1 0
  500. |    jsr    _nf_reduce
  501. |.o 0 0
  502. |    decI
  503. |    jmp    _reduce_args
  504. |_last1:    pop_a    1
  505. |_last:    pop_b    1
  506. |.d 0 0
  507. |    rtn
  508.  
  509. |.o 0 0
  510. |_nf_reducer
  511. |.d 1 0
  512. |    jsr    _nf_reduce
  513. |.o 0 0
  514. |    stop_reducer
  515.  
  516. .o 0 0
  517. _type_error
  518.     print    "Run Time Error: type error\n"
  519.     halt
  520.  
  521. .o 0 0
  522. index_error
  523.     print    "Run Time Error: index out of range\n"
  524.     halt
  525.  
  526. .o 1 0
  527. _print_graph
  528. .d 1 0
  529.     jsr    _print
  530. .o 0 0
  531.     print_sc    "\n"
  532. .d 0 0
  533.     rtn
  534.  
  535. .o 1 0
  536. _print    
  537.     pushI    0    | push the bracket count
  538. _continue_print
  539.     jsr_eval    0
  540. .o 1 1 i
  541. _print2
  542.     is_record    0
  543.     jmp_true    _print_record
  544.     eq_nulldesc    _Tuple 0
  545.     jmp_true    _print_tuple
  546.  
  547.     get_node_arity    0
  548.     eqI_b    0 0
  549.     jmp_true    _print_last
  550.  
  551.     eq_desc    _Cons 2 0
  552.     jmp_true    _print_list
  553.     eq_desc    ARRAY 1 0
  554.     jmp_true    _print_array
  555.  
  556.     print_sc    "("
  557.     print_symbol_sc    0
  558.     push_b    0
  559.     push_b    0    | replace the node by
  560.     repl_args_b        | leave arity on b-stack
  561. _print_args
  562.     print_sc    " "
  563.     eqI_b    1 0    | check if last argument
  564.     jmp_true    _print_last_arg
  565. .d 1 0
  566.     jsr    _print
  567. .o 0 0
  568.     decI        | decrease argument count
  569.     jmp    _print_args
  570. _print_last_arg
  571.     pop_b    1    | remove argument count
  572.     incI        | increment bracket count
  573.     jmp    _continue_print    | optimised tail recursion!
  574. _print_last
  575.     pop_b    1    | remove arity
  576.     eq_desc    _Nil 0 0
  577.     jmp_true    _print_nil
  578.     eq_desc    _ARRAY_ 0 0
  579.     jmp_true    _print__array_
  580.     eq_desc    _STRING_ 0 0
  581.     jmp_true    _print_char_array
  582.  
  583.     print_symbol_sc    0
  584.     pop_a    1    | remove node
  585. _print_brackets
  586.     eqI_b    0 0    | stop printing brackets if
  587.     jmp_true    _exit_brackets    | bracket count is zero
  588.     print_sc    ")"
  589.     decI        | decrement bracket count
  590.     jmp    _print_brackets
  591. _exit_brackets
  592.     pop_b    1    | remove bracket count
  593. .d 0 0
  594.     rtn
  595.  
  596. _print_list
  597.     pop_b    1
  598.     print_sc    "["
  599. _print_rest_list
  600.     repl_args    2 2
  601. .d 1 0
  602.     jsr    _print
  603. .o 0 0
  604.     jsr_eval 0
  605.     eq_desc    _Nil 0 0
  606.     jmp_true    _print_last_list
  607.     print_sc    ","
  608.     jmp    _print_rest_list            
  609. _print_last_list
  610.     print_sc    "]"
  611.     pop_a    1
  612.     jmp    _print_brackets
  613.  
  614. _print__array_
  615. .d 1 1 i
  616.     jmp    _print__array2
  617.  
  618. _print_array
  619.     pop_b    1
  620.     pushA_a    0
  621.     update_a    0 1
  622.     pop_a    1
  623. .o 1 1 i
  624. _print__array
  625.     eq_desc    _STRING_ 0 0
  626.     jmp_true    _print_char_array
  627. _print__array2
  628.     push_r_args_b    0 0 2 2 1
  629.  
  630.     print_sc    "{"
  631.  
  632.     push_b    0
  633.     eq_desc_b    BOOL 0
  634.     jmp_true    _print_bool_array
  635.  
  636.     push_b    0
  637.     eq_desc_b    INT 0
  638.     jmp_true    _print_int_array
  639.  
  640.     push_b    0
  641.     eq_desc_b    REAL 0
  642.     jmp_true    _print_real_array
  643.  
  644.     pushI    0
  645.  
  646.     push_a    0
  647.     push_arraysize    _ 0 1
  648.  
  649.     push_b    2
  650.     update_b    2 3
  651.     update_b    1 2
  652.     update_b    0 1
  653.     pop_b    1
  654.  
  655.     pushI    0
  656.     eqI
  657.     jmp_false    _print_record_array
  658.  
  659.     jmp    _print_array_lp2
  660. .o 1 2 i i
  661. _print_array_lp1
  662.     eqI_b    0 1
  663.     jmp_true    _no_comma_0
  664.     print_sc    ","
  665. _no_comma_0
  666.     push_b    1
  667.     push_a    0
  668.     select    _ 0 1
  669. .d 1 0
  670.     jsr    _print
  671. .o 0 0
  672.     push_b    1
  673.     incI
  674.     update_b    0 2
  675.     pop_b 1
  676.     decI
  677. _print_array_lp2
  678.     eqI_b    0 0
  679.     jmp_false    _print_array_lp1
  680.     pop_a    1
  681.     pop_b    2
  682.     print_sc    "}"
  683.     jmp    _print_brackets
  684.  
  685. _print_record_array
  686.     jmp    _print_record_array_lp2
  687. .o 1 2 i i
  688. _print_record_array_lp1
  689.     eqI_b    0 1
  690.     jmp_true    _no_comma_ar
  691.     print_sc    ","
  692. _no_comma_ar
  693.     push_r_args_b    0 0 2 2 1
  694.     printD
  695.  
  696.     push_b    1
  697.     push_a    0
  698.     push_a_r_args
  699.  
  700. _print_a_record_lp
  701.     push_b    0
  702.     push_r_arg_t
  703.     eqI_b    0 0
  704.     jmp_true    _end_print_a_record
  705.     print_sc    " "
  706.     eqC_b    'r' 0
  707.     jmp_true    _print_ar_real
  708.     eqC_b    'i' 0
  709.     jmp_true    _print_ar_integer
  710.     eqC_b    'c' 0
  711.     jmp_true    _print_ar_char
  712.     eqC_b    'b' 0
  713.     jmp_true    _print_ar_bool
  714.     eqC_b    'f' 0
  715.     jmp_true    _print_ar_file
  716.     eqC_b    'a' 0
  717.     jmp_true    _print_ar_graph
  718.     halt
  719.  
  720. _print_ar_integer
  721.     pop_b    1
  722.     push_b    1
  723.     update_b    1 2
  724.     update_b    0 1
  725.     pop_b    1
  726.  
  727.     print_int
  728.  
  729.     incI
  730.     jmp    _print_a_record_lp
  731.  
  732. _print_ar_char
  733.     pop_b    1
  734.     push_b    1
  735.     update_b    1 2
  736.     update_b    0 1
  737.     pop_b    1
  738.  
  739.     print_char
  740.  
  741.     incI
  742.     jmp    _print_a_record_lp
  743.  
  744. _print_ar_real
  745.     pop_b    1
  746.     push_b    2
  747.     push_b    2
  748.     update_b    2 4
  749.     update_b    1 3
  750.     update_b    0 2
  751.     pop_b    2
  752.  
  753.     create
  754.     fillR_b    0 0
  755.     pop_b    2
  756.  
  757.     print_symbol_sc    0
  758.     pop_a    1
  759.  
  760.     incI
  761.     jmp    _print_a_record_lp
  762.  
  763. _print_ar_bool
  764.     pop_b    1
  765.     push_b    1
  766.     update_b    1 2
  767.     update_b    0 1
  768.     pop_b    1
  769.     jmp_true    _print_r_true
  770.     
  771.     print    "False"
  772.     incI
  773.     jmp    _print_a_record_lp    
  774.  
  775. _print_ar_true
  776.     print    "True"
  777.     incI
  778.     jmp    _print_a_record_lp    
  779.  
  780. _print_ar_file
  781.     pop_b    1
  782.     update_b    0 2
  783.     pop_b    2
  784.  
  785.     print    "File"
  786.  
  787.     incI
  788.     jmp    _print_a_record_lp
  789.  
  790. _print_ar_graph
  791.     pop_b    1
  792.  
  793.     jsr_eval 0
  794.     pushI    0
  795.     eq_desc    _ARRAY_ 0 0
  796.     jmp_true    _print_a_array
  797. .d 1 1 i
  798.     jsr    _print2
  799. .o 0 0
  800.     incI
  801.     jmp    _print_a_record_lp
  802.  
  803. _print_a_array
  804. .d 1 1 i
  805.     jsr    _print__array
  806. .o 0 0
  807.     incI
  808.     jmp    _print_a_record_lp
  809.  
  810. _end_print_a_record
  811.     pop_b    2
  812.  
  813.     push_b    1
  814.     incI
  815.     update_b    0 2
  816.     pop_b 1
  817.     decI
  818. _print_record_array_lp2
  819.     eqI_b    0 0
  820.     jmp_false    _print_record_array_lp1
  821.     pop_a    1
  822.     pop_b    2
  823.     print_sc    "}"
  824.     jmp    _print_brackets
  825.  
  826. _print_char_array
  827.     print_sc    "\""
  828. .d 1 0
  829.     jsr    print_string_
  830. .o 0 0
  831.     print_sc    "\""
  832.     jmp    _print_brackets
  833.  
  834. _print_bool_array
  835.     pop_b    1
  836.     pushI    0
  837.     push_a    0
  838.     push_arraysize    BOOL 0 1
  839.     jmp    _print_bool_array_lp2
  840. .o 1 2 i i
  841. _print_bool_array_lp1
  842.     eqI_b    0 1
  843.     jmp_true    _no_comma_1
  844.     print_sc    ","
  845. _no_comma_1
  846.     push_b    1
  847.     push_a    0
  848.     select    BOOL 0 1
  849. .d 0 1 b    
  850.     jsr    _print_bool
  851. .o 0 0
  852.     push_b    1
  853.     incI
  854.     update_b    0 2
  855.     pop_b 1
  856.     decI
  857. _print_bool_array_lp2
  858.     eqI_b    0 0
  859.     jmp_false    _print_bool_array_lp1
  860.  
  861.     pop_a    1
  862.     pop_b    2
  863.     print_sc    "}"
  864.     jmp    _print_brackets
  865.  
  866. _print_int_array
  867.     pop_b    1
  868.     pushI    0
  869.     push_a    0
  870.     push_arraysize    INT 0 1
  871.     jmp    _print_int_array_lp2
  872. .o 1 2 i i
  873. _print_int_array_lp1
  874.     eqI_b    0 1
  875.     jmp_true    _no_comma_2
  876.     print_sc    ","
  877. _no_comma_2
  878.     push_b    1
  879.     push_a    0
  880.     select    INT 0 1
  881.     print_int
  882.  
  883.     push_b    1
  884.     incI
  885.     update_b    0 2
  886.     pop_b 1
  887.     decI
  888. _print_int_array_lp2
  889.     eqI_b    0 0
  890.     jmp_false    _print_int_array_lp1
  891.  
  892.     pop_a    1
  893.     pop_b    2
  894.     print_sc    "}"
  895.     jmp    _print_brackets
  896.  
  897. _print_real_array
  898.     pop_b    1
  899.     push_a    0
  900.     pushI    0
  901.     push_arraysize    REAL 0 2
  902.     jmp    _print_real_array_lp2
  903. .o 1 2 i i
  904. _print_real_array_lp1
  905.     eqI_b    0 1
  906.     jmp_true    _no_comma_3
  907.     print_sc    ","
  908. _no_comma_3
  909.     push_b    1
  910.     push_a    0
  911.     select    REAL 0 2
  912.  
  913.     create
  914.     fillR_b    0 0
  915.     pop_b    2
  916.     print_symbol_sc    0
  917.     pop_a    1
  918.  
  919.     push_b    1
  920.     incI
  921.     update_b    0 2
  922.     pop_b 1
  923.     decI
  924. _print_real_array_lp2
  925.     eqI_b    0 0
  926.     jmp_false    _print_real_array_lp1
  927.     pop_a    1
  928.     pop_b    2
  929.     print_sc    "}"
  930.     jmp    _print_brackets
  931.                     
  932. _print_nil
  933.     print_sc    "[]"
  934.     pop_a    1
  935.     jmp    _print_brackets
  936.  
  937. _print_tuple
  938.     print_sc    "("
  939.     get_node_arity    0
  940.     push_b    0
  941.     push_b    0
  942.     repl_args_b
  943. _print_rest_tuple
  944. .d 1 0
  945.     jsr    _print
  946. .o 0 0
  947.     decI
  948.     eqI_b    0 0
  949.     jmp_true    _exit_print_tuple
  950.     print_sc    ","
  951.     jmp    _print_rest_tuple
  952. _exit_print_tuple
  953.     pop_b    1
  954.     print_sc    ")"
  955.     jmp    _print_brackets
  956.  
  957. _print_record
  958.     print_sc    "("
  959.     print_symbol_sc    0
  960.  
  961.     push_t_r_args
  962.  
  963. _print_record_lp
  964.     push_b    0
  965.     push_r_arg_t
  966.     eqI_b    0 0
  967.     jmp_true    _end_print_record
  968.     print_sc    " "
  969.     eqC_b    'i' 0
  970.     jmp_true    _print_r_integer
  971.     eqC_b    'c' 0
  972.     jmp_true    _print_r_char
  973.     eqC_b    'r' 0
  974.     jmp_true    _print_r_real
  975.     eqC_b    'b' 0
  976.     jmp_true    _print_r_bool
  977.     eqC_b    'f' 0
  978.     jmp_true    _print_r_file
  979.     eqC_b    'a' 0
  980.     jmp_true    _print_r_graph
  981.     halt
  982.  
  983. _print_r_integer
  984.     pop_b    1
  985.     push_b    1
  986.     update_b    1 2
  987.     update_b    0 1
  988.     pop_b    1
  989.  
  990.     print_int
  991.  
  992.     incI
  993.     jmp    _print_record_lp
  994.  
  995. _print_r_char
  996.     pop_b    1
  997.     push_b    1
  998.     update_b    1 2
  999.     update_b    0 1
  1000.     pop_b    1
  1001.  
  1002.     print_char
  1003.  
  1004.     incI
  1005.     jmp    _print_record_lp
  1006.  
  1007. _print_r_real
  1008.     pop_b    1
  1009.     push_b    2
  1010.     push_b    2
  1011.     update_b    2 4
  1012.     update_b    1 3
  1013.     update_b    0 2
  1014.     pop_b    2
  1015.  
  1016.     create
  1017.     fillR_b    0 0
  1018.     pop_b    2
  1019.  
  1020.     print_symbol_sc    0
  1021.     pop_a    1
  1022.  
  1023.     incI
  1024.     jmp    _print_record_lp
  1025.  
  1026. _print_r_bool
  1027.     pop_b    1
  1028.     push_b    1
  1029.     update_b    1 2
  1030.     update_b    0 1
  1031.     pop_b    1
  1032. .d 0 1 b
  1033.     jsr    _print_bool
  1034. .o 0 0
  1035.     incI
  1036.     jmp    _print_record_lp    
  1037.  
  1038. .o 0 1 b
  1039. _print_bool
  1040.     jmp_true    _print_r_true
  1041.     
  1042.     print    "False"
  1043. .d 0 0
  1044.     rtn
  1045. _print_r_true
  1046.     print    "True"
  1047. .d 0 0
  1048.     rtn
  1049.  
  1050. _print_r_file
  1051.     pop_b    1
  1052.     update_b    0 2
  1053.     pop_b    2
  1054.  
  1055.     print    "File"
  1056.  
  1057.     incI
  1058.     jmp    _print_record_lp
  1059.  
  1060. _print_r_graph
  1061.     pop_b    1
  1062.  
  1063.     jsr_eval 0
  1064.     eq_desc    _ARRAY_ 0 0
  1065.     jmp_true    _print_r_array
  1066.  
  1067.     push_b    0
  1068.     incI
  1069.     push_r_arg_t
  1070.     pushI    0
  1071.     eqI
  1072.     jmp_true    _print_last_record_arg
  1073.  
  1074.     pushI    0
  1075. .d 1 1 i
  1076.     jsr    _print2
  1077. .o 0 0
  1078.     incI
  1079.     jmp    _print_record_lp
  1080.  
  1081. _print_last_record_arg
  1082.     pop_b    1
  1083.     incI
  1084.     jmp    _print2
  1085.  
  1086. _print_r_array
  1087.     pushI    0
  1088. .d 1 1 i
  1089.     jsr    _print__array
  1090. .o 0 0
  1091.     incI
  1092.     jmp    _print_record_lp
  1093.  
  1094. _end_print_record
  1095.     pop_b    2
  1096.     incI
  1097.     jmp    _print_brackets
  1098.     
  1099. .o 1 0
  1100. _eval_to_nf
  1101. .d 1 0
  1102.     jsr    _eval
  1103. .o 0 0
  1104. .d 0 0
  1105.     rtn
  1106.  
  1107. .o 1 0
  1108. _eval
  1109.     pushI    0        | push the bracket count
  1110. _continue_eval
  1111.     jsr_eval    0
  1112. .o 1 1 i
  1113. _eval2
  1114.     is_record    0
  1115.     jmp_true    _eval_record
  1116.     eq_nulldesc    _Tuple 0
  1117.     jmp_true    _eval_tuple
  1118.  
  1119.     get_node_arity    0
  1120.     eqI_b    0 0        | check if arity is zero
  1121.     jmp_true    _eval_last
  1122.  
  1123.     eq_desc    _Cons 2 0
  1124.     jmp_true    _eval_list
  1125.     eq_desc    ARRAY 1 0
  1126.     jmp_true    _eval_array
  1127.     push_b    0
  1128.     push_b    0        | replace the node by
  1129.     repl_args_b            | leave arity on b-stack
  1130. _eval_args
  1131.     eqI_b    1 0        | check if last argument
  1132.     jmp_true    _eval_last_arg
  1133. .d 1 0
  1134.     jsr    _eval
  1135. .o 0 0
  1136.     decI            | decrease argument count
  1137.     jmp    _eval_args
  1138. _eval_last_arg
  1139.     pop_b    1        | remove argument count
  1140.     incI            | increment bracket count
  1141.     jmp    _continue_eval        | optimised tail recursion!
  1142. _eval_last
  1143.     pop_b    1        | remove arity
  1144.     eq_desc    _Nil 0 0
  1145.     jmp_true    _eval_nil
  1146.     eq_desc    _ARRAY_ 0 0
  1147.     jmp_true    _eval__array_
  1148.     pop_a    1        | remove node
  1149. _eval_brackets
  1150.     eqI_b    0 0
  1151.     jmp_true    _exit_eval_brackets    | bracket count is zero
  1152.     decI            | decrement bracket count
  1153.     jmp    _eval_brackets
  1154. _exit_eval_brackets
  1155.     pop_b    1        | remove bracket count
  1156. .d 0 0
  1157.     rtn
  1158.  
  1159. _eval_list
  1160.     pop_b    1
  1161. _eval_rest_list
  1162.     repl_args    2 2
  1163. .d 1 0
  1164.     jsr    _eval
  1165. .o 0 0
  1166.     jsr_eval 0
  1167.     eq_desc    _Nil 0 0
  1168.     jmp_true    _eval_last_list
  1169.     jmp    _eval_rest_list            
  1170. _eval_last_list
  1171.     pop_a    1
  1172.     jmp    _eval_brackets
  1173.  
  1174. _eval__array_
  1175. .d 1 1 i
  1176.     jmp    _eval__array2
  1177.  
  1178. _eval_array
  1179.     pop_b    1
  1180.     pushA_a    0
  1181.     update_a    0 1
  1182.     pop_a    1
  1183. .o 1 1 i
  1184. _eval__array
  1185.     eq_desc    _STRING_ 0 0
  1186.     jmp_true    _eval_char_array
  1187. _eval__array2
  1188.     push_r_args_b    0 0 2 2 1
  1189.  
  1190.     push_b    0
  1191.     eq_desc_b    BOOL 0
  1192.     jmp_true    _eval_bool_array
  1193.  
  1194.     push_b    0
  1195.     eq_desc_b    INT 0
  1196.     jmp_true    _eval_int_array
  1197.  
  1198.     push_b    0
  1199.     eq_desc_b    REAL 0
  1200.     jmp_true    _eval_real_array
  1201.  
  1202.     pushI    0
  1203.  
  1204.     push_a    0
  1205.     push_arraysize    _ 0 1
  1206.  
  1207.     push_b    2
  1208.     update_b    2 3
  1209.     update_b    1 2
  1210.     update_b    0 1
  1211.     pop_b    1
  1212.  
  1213.     pushI    0
  1214.     eqI
  1215.     jmp_false    _eval_record_array
  1216.  
  1217.     jmp    _eval_array_lp2
  1218. .o 1 2 i i
  1219. _eval_array_lp1
  1220.     push_b    1
  1221.     push_a    0
  1222.     select    _ 0 1
  1223. .d 1 0
  1224.     jsr    _eval
  1225. .o 0 0
  1226.     push_b    1
  1227.     incI
  1228.     update_b    0 2
  1229.     pop_b 1
  1230.     decI
  1231. _eval_array_lp2
  1232.     eqI_b    0 0
  1233.     jmp_false    _eval_array_lp1
  1234.     pop_a    1
  1235.     pop_b    2
  1236.     jmp    _eval_brackets
  1237.  
  1238. _eval_record_array
  1239.     jmp    _eval_record_array_lp2
  1240. .o 1 2 i i
  1241. _eval_record_array_lp1
  1242.     push_b    1
  1243.     push_a    0
  1244.     push_a_r_args
  1245.  
  1246. _eval_a_record_lp
  1247.     push_b    0
  1248.     push_r_arg_t
  1249.     eqI_b    0 0
  1250.     jmp_true    _end_eval_a_record
  1251.     eqC_b    'i' 0
  1252.     jmp_true    _eval_ar_integer
  1253.     eqC_b    'c' 0
  1254.     jmp_true    _eval_ar_char
  1255.     eqC_b    'r' 0
  1256.     jmp_true    _eval_ar_real
  1257.     eqC_b    'b' 0
  1258.     jmp_true    _eval_ar_bool
  1259.     eqC_b    'f' 0
  1260.     jmp_true    _eval_ar_file
  1261.     eqC_b    'a' 0
  1262.     jmp_true    _eval_ar_graph
  1263.     halt
  1264.  
  1265. _eval_ar_bool
  1266. _eval_ar_char
  1267. _eval_ar_integer
  1268.     pop_b    1
  1269.     update_b    0 1
  1270.     pop_b    1
  1271.  
  1272.     incI
  1273.     jmp    _eval_a_record_lp
  1274.  
  1275. _eval_ar_file
  1276. _eval_ar_real
  1277.     pop_b    1
  1278.     update_b    0 2
  1279.     pop_b    2
  1280.  
  1281.     incI
  1282.     jmp    _eval_a_record_lp
  1283.  
  1284. _eval_ar_graph
  1285.     pop_b    1
  1286.  
  1287.     jsr_eval    0
  1288.     pushI    0
  1289.     eq_desc    _ARRAY_ 0 0
  1290.     jmp_true    _eval_a_array
  1291. .d 1 1 i
  1292.     jsr    _eval2
  1293. .o 0 0
  1294.     incI
  1295.     jmp    _eval_a_record_lp
  1296.  
  1297. _eval_a_array
  1298. .d 1 1 i
  1299.     jsr    _eval__array
  1300. .o 0 0
  1301.     incI
  1302.     jmp    _eval_a_record_lp
  1303.  
  1304. _end_eval_a_record
  1305.     pop_b    2
  1306.  
  1307.     push_b    1
  1308.     incI
  1309.     update_b    0 2
  1310.     pop_b 1
  1311.     decI
  1312. _eval_record_array_lp2
  1313.     eqI_b    0 0
  1314.     jmp_false    _eval_record_array_lp1
  1315.     pop_a    1
  1316.     pop_b    2
  1317.     jmp    _eval_brackets
  1318.  
  1319. _eval_char_array
  1320.     pop_a    1
  1321.     jmp    _eval_brackets
  1322.  
  1323. _eval_real_array
  1324. _eval_bool_array
  1325. _eval_int_array
  1326.     pop_b    1
  1327.     pop_a    1
  1328.     jmp    _eval_brackets
  1329.                     
  1330. _eval_nil
  1331.     pop_a    1
  1332.     jmp    _eval_brackets
  1333.  
  1334. _eval_tuple
  1335.     get_node_arity    0
  1336.     push_b    0
  1337.     push_b    0
  1338.     repl_args_b
  1339. _eval_rest_tuple
  1340. .d 1 0
  1341.     jsr    _eval
  1342. .o 0 0
  1343.     decI
  1344.     eqI_b    0 0
  1345.     jmp_true    _exit_eval_tuple
  1346.     jmp    _eval_rest_tuple
  1347. _exit_eval_tuple
  1348.     pop_b    1
  1349.     jmp    _eval_brackets
  1350.  
  1351. _eval_record
  1352.     push_t_r_args
  1353. _eval_record_lp
  1354.     push_b    0
  1355.     push_r_arg_t
  1356.     eqI_b    0 0
  1357.     jmp_true    _end_eval_record
  1358.     eqC_b    'r' 0
  1359.     jmp_true    _eval_r_real
  1360.     eqC_b    'i' 0
  1361.     jmp_true    _eval_r_integer
  1362.     eqC_b    'c' 0
  1363.     jmp_true    _eval_r_char
  1364.     eqC_b    'b' 0
  1365.     jmp_true    _eval_r_bool
  1366.     eqC_b    'f' 0
  1367.     jmp_true    _eval_r_file
  1368.     eqC_b    'a' 0
  1369.     jmp_true    _eval_r_graph
  1370.     halt
  1371.  
  1372. _eval_r_char
  1373. _eval_r_bool
  1374. _eval_r_integer
  1375.     pop_b    1
  1376.     update_b    0 1
  1377.     pop_b    1
  1378.     incI
  1379.     jmp    _eval_record_lp
  1380.  
  1381. _eval_r_file
  1382. _eval_r_real
  1383.     pop_b    1
  1384.     update_b    0 2
  1385.     pop_b    2
  1386.     incI
  1387.     jmp    _eval_record_lp
  1388.  
  1389. _eval_r_graph
  1390.     pop_b    1
  1391.  
  1392.     jsr_eval 0
  1393.     eq_desc    _ARRAY_ 0 0
  1394.     jmp_true    _eval_r_array
  1395.  
  1396.     push_b    0
  1397.     incI
  1398.     push_r_arg_t
  1399.     pushI    0
  1400.     eqI
  1401.     jmp_true    _eval_last_record_arg
  1402.  
  1403.     pushI    0
  1404. .d 1 1 i
  1405.     jsr    _eval2
  1406. .o 0 0
  1407.     incI
  1408.     jmp    _eval_record_lp
  1409.  
  1410. _eval_last_record_arg
  1411.     pop_b    1
  1412.     incI
  1413.     jmp    _eval2
  1414.  
  1415. _eval_r_array
  1416.     pushI    0
  1417. .d 1 1 i
  1418.     jsr    _eval__array
  1419. .o 0 0
  1420.     incI
  1421.     jmp    _eval_record_lp
  1422.  
  1423. _end_eval_record
  1424.     pop_b    2
  1425.     incI
  1426.     jmp    _eval_brackets
  1427.